perm filename AEJ[PIC,LCS] blob
sn#039044 filedate 1973-12-30 generic text, type T, neo UTF8
00100 SUBROUTINE EDGE(X,Y)
00200
00300 C DECEMBER 12, 68
00400
00500
00600 DIMENSION T(0/1770)
00700
00800 REAL A0,A1,A2,A3,A4,A5,A6,A7,
00900 1 COH,B,
01000 2 AF,CL,C2L,CW,D,
01100 3 LEN,L,RO,SL,SW,
01200 4 S2L,RX,RY,HALF,RO2,
01300 5 HEL,RR,RORR,Q,LC,
01400 6 E,EC,ES,ECP,ESP,EX,SQ,SQP
01500
01600 INTEGER COUNT,X,Y
01700
01800 LOGICAL DEBUG
01900
02000 COMMON /EDGEC/ A0,A1,A2,A3,A4,A5,A6,A7,
02100 1 DEBUG,T,
02200 1 HALF,FILE,RR,COH,RX,RY,CL,SL,D,B,FOUND
02300
02400 CALL PROJEC(X,Y)
02500
02600 Q=SQRT(6.*A1**2+2.*(A2**2+A3**2+A4**2+A5**2)+
02700 1 3.*(A6**2+A7**2))
02800
02900 COUNT=-1
03000 L=1.
03100 CL=A2+A4
03200 SL=A3+A5
03300
03400 100 COUNT=COUNT+1
03500 LEN=SQRT(CL**2+SL**2)
03600 CL=CL/LEN
03700 SL=SL/LEN
03800 E=A2*CL+A3*SL
03900 IF(E.GT.0.) GOTO 200
03910 CC IF(E.GT.0.) GOTO 150
04000 CL=-CL
04100 SL=-SL
04200 E=-E
04300 CC150 IF(.NOT.DEBUG) GOTO 200
04400 CC CALL ASD(2,'CL',CL)
04500 CC CALL ASD(2,'SL',SL)
04600 200 C2L=CL**2-SL**2
04700 S2L=2.*SL*CL
04800 EC=A4*CL+A5*SL
04900 EX=A6*C2L+A7*S2L
05000 ES=A1+EX
05100 SQ=SQRT(EC**2+ES**2)
05200 IF(L**2.LT.1.E-3.OR.COUNT.GT.1) GOTO 250
05300 ECP=-A4*SL+A5*CL
05400 ESP=2.*(-A6*S2L+A7*C2L)
05500 SQP=(EC*ECP+ES*ESP)/SQ
05600 L=-(-A2*SL+A3*CL+SQP)/(-E+(-SQP**2+
05700 1 ECP**2+ESP**2-EC**2-4.*ES*EX)/SQ)
05800 HEL=1.-(L**2)/2.
05900 LC=CL
06000 CL=CL*HEL-SL*L
06100 SL=SL*HEL+LC*L
06200 GOTO 100
06300
06400 250 CW=EC/SQ
06500 IF(CW.GE.0.) GOTO 260
06600 COH=0.
06700 D=0.
06800 B=0.
06900 RETURN
07000 260 SW=ES/SQ
07100 CC IF(.NOT.DEBUG) GOTO 300
07200 CC CALL ASD(4,'COUNT',COUNT)
07300 CC CALL ASD(4,'CW',CW)
07400 CC CALL ASD(4,'SW',SW)
07500 300 AF=E+SQ
07600 RO=SW/(1.4142136*(1.+CW))
07700 RO2=RO**2
07800 D=AF*1.30294/((1.-RO2)**2*(1.+2.*RO2))
07900 COH=AF/Q
08000 RORR=RO*RR
08100 RX=FLOAT(X)+0.5-HALF+CL*RORR
08200 RY=FLOAT(Y)+0.5-HALF+SL*RORR
08300 B=A0-D*(4.+RO*(3.+RO*(2.+RO)))*((1.-RO)**2)*0.125
08400 IF(COH.LT.-1.0.OR.1.0.LT.COH) PAUSE 'COH CHECK IN EDGE'
08500 CC400 IF(.NOT.DEBUG) RETURN
08600 CC
08700 CC CALL ASD(3,'COH',COH)
08800 CC CALL ASD(3,'D',D)
08900 CC CALL ASD(3,'B',B)
09000 CC CALL ASD(3,'RX',RX)
09100 CC CALL ASD(3,'RY',RY)
09200 CC CALL ACTES(RO,D,CL,SL)
09300 RETURN
09400 END